home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / NEWINT~1 / TRACBA~1 / FRMTRA~1.FRM next >
Text File  |  1997-06-04  |  4KB  |  146 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "TracBar (Slider Control)"
  4.    ClientHeight    =   4410
  5.    ClientLeft      =   4635
  6.    ClientTop       =   3300
  7.    ClientWidth     =   5655
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   4410
  10.    ScaleWidth      =   5655
  11.    StartUpPosition =   2  'CenterScreen
  12.    Begin VB.TextBox Text3 
  13.       Height          =   285
  14.       Left            =   3780
  15.       TabIndex        =   4
  16.       Text            =   "1"
  17.       Top             =   2205
  18.       Width           =   810
  19.    End
  20.    Begin VB.TextBox Text2 
  21.       Height          =   285
  22.       Left            =   1050
  23.       TabIndex        =   2
  24.       Text            =   "1"
  25.       Top             =   3615
  26.       Width           =   810
  27.    End
  28.    Begin VB.TextBox Text1 
  29.       Height          =   285
  30.       Left            =   4200
  31.       TabIndex        =   1
  32.       Text            =   "1"
  33.       Top             =   1170
  34.       Width           =   810
  35.    End
  36.    Begin VB.CommandButton Command1 
  37.       Caption         =   "Set Slider position to ---->"
  38.       Height          =   405
  39.       Left            =   1515
  40.       TabIndex        =   0
  41.       Top             =   2130
  42.       Width           =   2070
  43.    End
  44.    Begin VB.Label Label1 
  45.       BackStyle       =   0  'Transparent
  46.       Caption         =   $"frmTracBar.frx":0000
  47.       BeginProperty Font 
  48.          Name            =   "MS Sans Serif"
  49.          Size            =   8.25
  50.          Charset         =   0
  51.          Weight          =   700
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   810
  57.       Left            =   165
  58.       TabIndex        =   3
  59.       Top             =   150
  60.       Width           =   5430
  61.    End
  62. End
  63. Attribute VB_Name = "Form1"
  64. Attribute VB_GlobalNameSpace = False
  65. Attribute VB_Creatable = False
  66. Attribute VB_PredeclaredId = True
  67. Attribute VB_Exposed = False
  68. Dim SliderH As New CTracBar32
  69. Dim SliderV As New CTracBar32
  70. Private Const WM_PAINT = &HF
  71. Private Const WM_VSCROLL = &H115
  72. Private Const WM_HSCROLL = &H114
  73.  
  74. Private Sub Command1_Click()
  75. SliderH.SetTracBarPos CInt(Text3)
  76. SliderV.SetTracBarPos CInt(Text3)
  77. Text1 = SliderH.GetTracBarPos
  78. Text2 = SliderV.GetTracBarPos
  79. End Sub
  80.  
  81. Private Sub Form_Load()
  82.  
  83. With SliderH
  84. Set .Parent = Me
  85.     .Create 70, 70, 200, 35
  86. End With
  87.  
  88. With SliderV
  89. Set .Parent = Me
  90.     .Create 20, 70, 35, 200, True
  91.  
  92. End With
  93.  
  94. 'Subclass form to receive messages
  95. SubClass Me.hwnd
  96. Me.Show
  97. Text3.SetFocus
  98.  
  99. End Sub
  100.  
  101. Public Sub ProcMsg(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
  102.    
  103. On Error Resume Next
  104.  
  105. Select Case uMsg
  106.  
  107. Case WM_HSCROLL
  108. 'the window being scrolled is the slider we created then
  109. 'Get the position
  110. If lParam = SliderH.GetTracBarHwnd Then
  111. Text1 = SliderH.GetTracBarPos
  112. End If
  113.  
  114. Case WM_VSCROLL
  115. If lParam = SliderV.GetTracBarHwnd Then
  116. Text2 = SliderV.GetTracBarPos
  117. End If
  118.  
  119. End Select
  120. End Sub
  121.  
  122. Private Sub SubClass(hwnd As Long)
  123. On Error Resume Next
  124. NextProcs = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
  125. End Sub
  126. Private Sub UnSubClass()
  127. Dim hWndCur As Long
  128. hWndCur = Me.hwnd
  129. If NextProcs Then
  130. SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
  131. NextProcs = 0
  132. End If
  133. End Sub
  134.  
  135. Private Sub Form_Unload(Cancel As Integer)
  136. UnSubClass
  137. End Sub
  138.  
  139.  
  140. Private Sub Text3_KeyPress(KeyAscii As Integer)
  141. If KeyAscii < 49 Or KeyAscii > 57 Then
  142. KeyAscii = 0
  143. Exit Sub
  144. End If
  145. End Sub
  146.